home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / pcmania / demo64 / fire.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-21  |  2.8 KB  |  103 lines
  1.  
  2. { HEY! PcManíacos:                                               }
  3.  
  4. { Si queréis contactar con los autores de esta sección,          }
  5. { ahora podéis hacerlo a través de sus e-mails privados:         }
  6.  
  7. { Miquel Barceló: (Demoscene)                                    }
  8. {                               e-mail: sa281@blues.uab.es       }
  9.  
  10. { Eduard Sánchez Palazón (Curso de ficheros musicales/Demoscene) }
  11. {                               e-mail: eduard@ergos.es          }
  12.  
  13. { Esperamos vuestros mensajes!                                   }
  14.  
  15. { -------------------------------------------------------------- }
  16. {  Efectos Recursivos / fire.pas                                 }
  17. {  Por Miquel Barceló                                            }
  18. { -------------------------------------------------------------- }
  19.  
  20. uses crt,graf;
  21.  
  22. procedure Prepara_Paleta;
  23. var
  24.    cont  : integer;
  25.    r,g,b : byte;
  26. begin
  27.      for cont:=0 to 119 do begin
  28.          putrgb(cont,50*cont div 119,0,0);
  29.      end;
  30.      for cont:=120 to 219 do begin
  31.          putrgb(cont,50+(cont-120)*13 div 99,(cont-120)*63 div 99,0);
  32.      end;
  33.      for cont:=220 to 255 do begin
  34.          putrgb(cont,63,63,(cont-220)*63 div 35);
  35.      end;
  36. end;
  37.  
  38. procedure bloque(segment,offset:word;col:byte);
  39. begin
  40.      mem[segment:offset]:=col;
  41.      mem[segment:offset+1]:=col;
  42.      mem[segment:offset+2]:=col;
  43.      mem[segment:offset+3]:=col;
  44.      mem[segment:offset+4]:=col;
  45.      mem[segment:offset+320]:=col;
  46.      mem[segment:offset+321]:=col;
  47.      mem[segment:offset+322]:=col;
  48.      mem[segment:offset+323]:=col;
  49.      mem[segment:offset+324]:=col;
  50. end;
  51.  
  52. procedure Modifica_Resultado (donde: pointer; num_bloques : integer);
  53. var
  54.    cont           : integer;
  55.    segment,offset : word;
  56. begin
  57.      segment:=seg(donde^);
  58.      offset :=ofs(donde^);
  59.      for cont:=0 to num_bloques do
  60.          bloque (segment,offset+62721+random(312),230+random(25));
  61. end;
  62.  
  63. procedure Fuego (donde: pointer);
  64. var
  65.    cont           : word;
  66.    segment,offset : word;
  67.    temp           : byte;
  68. begin
  69.      segment:=seg(donde^);
  70.      offset :=ofs(donde^);
  71.      for cont:=offset to offset+63360 do
  72.      begin
  73.           temp:=(mem[segment:cont]+
  74.                  mem[segment:cont+319]+
  75.                  mem[segment:cont+321]+
  76.                  mem[segment:cont+640])shr 2;
  77.           if temp<>0 then temp:=temp-1;
  78.           mem[segment:cont]:=temp;
  79.      end;
  80. end;
  81.  
  82. var
  83.    pant :pointer;
  84.    c    :integer;
  85.  
  86. begin
  87.      getmem(pant,64000);
  88.      cls(0,pant^);
  89.      Set_Vga;
  90.      Prepara_Paleta;
  91.      repeat
  92.            Modifica_Resultado (pant,40);
  93.            Fuego(pant);
  94.            flip(pant^,vga^);
  95.      until keypressed;
  96.      for c:=40 downto 0 do begin
  97.            Modifica_Resultado (pant,c);
  98.            Fuego(pant);
  99.            flip(pant^,vga^);
  100.      end;
  101.      Set_Text;
  102.      freemem(pant,64000);
  103. end.